home *** CD-ROM | disk | FTP | other *** search
/ Aminet 7 / Aminet 7 - August 1995.iso / Aminet / comm / mebbs / brldx38.lha / doors / BBSROLODEX / BBSRolodex.rexx < prev    next >
OS/2 REXX Batch file  |  1994-11-27  |  61KB  |  2,271 lines

  1. /* BBS ROLODEX by Larry Cloud M3001  Last modified:  11/27/94 */
  2.  
  3. signal on ERROR
  4. parse arg Ln
  5. options results
  6. if( ~show( 'l', "mebbsarexx.library" ) )then do
  7.  if( ~addlib( "mebbsarexx.library", 0, -30, 0 ) )then do
  8.   say "Could not open library"
  9.   exit 10
  10.  end
  11. end
  12.  
  13. dn = "BBS Rolodex"
  14. call GetVar dn,ln,1
  15. un = result
  16. author = "Larry Cloud"
  17. vers="3.8"
  18. mp = "DOORS:BBSROLODEX/"  /* Main path where BBS Rolodex is stored */
  19.  
  20. if ~exists("MEBBSNET:CONFIGFILES/BBSROLODEX.CFG") then do
  21. str="The configuration file for this door was not found, exiting...";call out
  22. signal getout
  23. end
  24. call open(file,"MEBBSNET:CONFIGFILES/bbsrolodex.cfg",'r');sysop=readln(file);zippath=readln(file);lhapath=readln(file);uuepath=readln(file);haszip=readln(file)
  25. haslha=readln(file);hasuue=readln(file);mynf=readln(file);email=readln(file);call close(file)
  26. NF.1 ="XXX-XXX-XXXX";NF.2 ="XXX-XXXX-XXXX";NF.3 ="XXXX-XXXXX";NF.4 ="XX-XX-XXXXXX";NF.5 ="XX-XXX-XXXXX";NF.6 ="XX-X-XXXXXX";NF.7 ="XX-XXX-XXXXXX";NF.8 ="XX-XXXXXXXX"
  27. NF.9 ="XXX-X-XXXXXXX";NF.10="XXX-XX-XXXXXX";NF.11="XXX-XX-XXXXXXX";NF.12="XXX-XXX-XXXXX";NF.13="XX-XXXXXXXX";NF.14="XX-XX-XXXXXXX";NF.15="XX-XXXX-XXXX";NF.16="XX-XXXX-XXXXX"
  28. NF.17="XX-XXXX-XXXXXX";NF.18="XX-XXXX-XXXX-XX";NF.19="XX-XXX-XXXXXXX";NF.20="XX-X-XXXXXXXXX";NF.21="XX-XXXXXXX";NF.22="XX-X-XXXXXXX";NF.23="XX-X-XXX-XXXX";NF.24="XX-XX-XX-XXXX"
  29. NF.25="XXX-X-XXXXXX";NF.26="XX-XX-XXX-XXX";NF.27="XX-XX-XXXXX";NF.28="XXX-X-XXX-XXXX";NF.29="XX-X-XXX-XXX";NF.30="XXX-X-XXX-XXX";NF.31="XX-X-XXXXXXXX";NF.32="X-XXXX-XXXXXX"
  30. NF.33="X-XXXX-XX-XXXX";NF.34="X-XXX-XXX-XXXX";NF.35="X-XXX-XXX-XXX";NF.36="X-XXX-XX-XXXXX";NF.37="XX-XX-XXX-XXXX";NF.38="XXX-X-XX-XXXX";NF.39="XXX-X-XXXX-XXXX";NF.40="XX-XXX-XX-XXXX"
  31. lg=length(NF.myNF);dc = 0
  32. do i=1 to lg
  33.  tstr=substr(NF.myNF,i,1)
  34.  if tstr="-" then do
  35.   dc = dc + 1
  36.   dct.dc=i
  37.  end
  38. end
  39. inuseuser="";inuseline=0;nuked=0;bla = "";red = "";grn = "";yel = "";cya = "";wht = ""
  40. itl = "";bold = "";nor = "";cls = "H";purbak = "";grnbak = "";whtbak = "";home = "H";pur = ""
  41. ll="-------------------------------------------------------------------------------"
  42. dpth = mp||"DATA/";ipth = mp||"INDEX/";dlflag=0;MODun = space(un,1,"_");pet=cya||"Please enter the "||pur||bold;peu=nor||cya||" (MAX of ";pev=" characters/line)"
  43. dtb=cya||"Does this BBS support ";sp="                    ";str1=sp||cya||"{";str2=cya||"}"||grn
  44. if exists(mp"INUSE.TXT") then do
  45.  call open(file,mp"inuse.txt",'R');inuseuser=readln(file);inuseline=readln(file);call close(file)
  46.  if inuseline=~ln then do
  47.   call bl;str =cls||"BBS Rolodex is currently in use by "||inuseuser||" on line "||inuseline||"."
  48.   call out;str ="Please try back in a little while...";call out;call bl;call returnc;call INUSEENDIT
  49.  end
  50. end
  51. call open(file,mp||"INUSE.txt", 'W');call writeln(file,un);call writeln(file,ln);call close(file)
  52. SYSOP = upper(SYSOP)
  53. call GetVar dn,ln,8
  54. grtype=result
  55. call GetVar dn,ln,10
  56. screen = result
  57. IF grtype < 1 THEN DO
  58.  pur = "";str ="";call out
  59.  str ="According to your SETUP you are NOT using ANSI.  This program requires an";call out
  60.  str ="ANSI compatible terminal program.  If your terminal program supports ANSI";call out
  61.  str ="coloring and cursor positioning, you may continue.";call out
  62.  str ="If NOT please get an ANSI compatible terminal program before answering YES.";call out
  63.  str ="If you choose to risk it and get a bunch of weird characters on your screen,";call out
  64.  str ="wait until the text stops and then press your Q key then press return and you";call out
  65.  str ="will exit this door, returning to the BBS.";call out;call bl
  66.  str="Continue anyway? (Y/n) > ";call getkey
  67.  answer = upper(hot)
  68.  if answer = "N" then do
  69.   nor = "";str=nor;call out;signal endit
  70.  end
  71. END
  72. totalcards = 0
  73. if screen < 23 then do
  74.  call lf2
  75.  str ="According to your setup from the BBS, you have your screen rows set";call out
  76.  str ="to "||screen||".";call out;call bl
  77.  str ="In order to view the FULL screens in this door you need to be able";call out
  78.  str ="to view at least 23 lines per screen. You may still continue, but it";call out
  79.  str ="is recommended you have a term program that will allow at least 23";call out
  80.  str ="lines.  This conforms to ANSI standard.";call out;call returnc
  81. end
  82.  
  83. SETUP:
  84. if ~exists(dpth||"total") then do
  85.  str =cls;call out
  86.  str =yel"First time set up...";call out;call bl
  87.  str =grn"Creating "||itl||pur||"BBS ROLODEX"||nor||grn||" files..";call out
  88.  call open(file,mp||"PHONES/TOTAL", 'W');call writeln(file,"0");call close(file)
  89.  call open(file,mp||"PHONES/NUMBERS", 'W');call close(file)
  90.  call open(file,dpth||"TOTAL", 'W');call writeln(file, "0");call close(file)
  91.  str =red||"DONE";call out;call bl;str =grn||"Creating index..";call out
  92.  do i=1 to 26;number=i;call numbercv;call createdir;end;drop flag;str =red||"Misc..";call out
  93.  call open(file,dpth||"MISC",'W');call close(file)
  94.   address command"makedir "||ipth||"MISC"
  95.  call open(file,ipth||"MISC/TOTAL",'W');call writeln(file,"0");call close(file)
  96.  str =wht||"ALL DONE!";call out;drop flag;call returnc
  97. end
  98. signal main
  99.  
  100. out:
  101. call message dn,ln,str,1
  102. return
  103.  
  104. bl:
  105. str = "";call out;return
  106.  
  107. MAIN:
  108. tpath = 0;breakloop = 0
  109. if exists(dpth||"TOTAL") then do
  110.  call open(file,dpth||"total",'R');totalcards = readln(file);call close(file)
  111. end
  112. str =cls||nor||sp||"        "||purbak||"BBS ROLODEX V"||vers||nor;call out
  113. str =sp||"      "||wht||"Copyright 1993, 1994";call out;str =sp||wht||"  Original By Keith Thibodeaux";call out
  114. str =sp||wht||"    Rewritten by Larry Cloud";call out;str =sp||"    Support BBS 206-698-0515";call out
  115. str =sp||"            and 206-698-7760";call out;str =sp||"     MEBBS DEVELOPER #M3001";call out;call bl;call bl
  116. if totalcards > 0 then do
  117.  str =str1||"R"||str2||" Read/Edit Cards (Verbose or Mini)";call out
  118.  str =str1||"S"||str2||" Search BBS ROLODEX w/Text string";call out
  119.  str =str1||"D"||str2||" Download List (Verbose or Mini)";call out
  120. end
  121. str =str1||"C"||str2||" Create a BBS ROLODEX Card";call out
  122. str =str1||"I"||str2||" Instructions";call out
  123. str =str1||"Q"||str2||" Quit to BBS";call out
  124. if SYSOP = upper(un) then do
  125.  str =str1||"$"||str2||" SYSOP MENU";call out
  126. end
  127. call bl;call cardcount
  128. str=wht||"Your Choice > ";call getkey
  129. ch = upper(hot);str=ch;call out;call bl
  130. if ch = "$" & sysop=upper(un) then signal sysopmain
  131. if totalcards > 0 then do
  132.  if ch = "D" then signal dlmenu
  133.  if ch = "R" then signal rmnu
  134.  if ch = "S" then signal smnu
  135. end
  136. if ch = "C" then signal MAKE
  137. if ch = "I" then signal INS
  138. if ch = "Q" then signal ENDIT
  139. call bl;str =RED||"INVALID OPTION";call out;call returnc;signal MAIN
  140.  
  141. INS:
  142. str =cls||cya;call out
  143. call readfile dn,ln,mp||"text/instructions";call bl
  144. str =wht||"End of list. ";call out;call returnc;signal main
  145.  
  146. cmt:
  147. call bl;call bl;str = "Choose a compression type:";call out;call bl;str = "{Q}uit  {N}one"
  148. if haslha=1 then str=str||"  {L}HA/LZH"
  149. if haszip=1 then str=str||"  {Z}IP"
  150. if hasuue=1 then str=str||"  {U}UE"
  151. call out;str="Choice? ";call getkey;answer = upper(hot);str=answer;call out;call bl
  152. if answer="Q" then signal dlmenu
  153. if haslha=1 then do
  154.  if answer = "L" then do
  155.   compression = "LHA";  call bl;return
  156.  end
  157. end
  158. if haszip=1 then do
  159.  if answer = "Z" then do
  160.   compression = "ZIP";call bl;return
  161.  end
  162. end
  163. if hasuue=1 then do
  164.  if answer = "U" then do
  165.   compression = "UUE";call bl;return
  166.  end
  167. end
  168. if answer="N" then do
  169.  compression = "TXT";call bl;return
  170. end;signal cmt
  171.  
  172. dlmenu:
  173. str =cls||sp"          "purbak||wht"DOWNLOAD MENU"nor;call out;call lf2
  174. str =str1||"V"||str2||" Verbose DOWNLOAD (All Info)";call out;str =str1||"M"||str2||" Mini-List DOWNLOAD (Main Info)";call out
  175. str =str1||"Q"||str2||" Quit to Main Menu";call out;call lf2;call cardcount;str=wht||"Your Choice > "
  176. call getkey;answer = upper(hot);str=answer;call out;call bl
  177. if answer = "Q" then signal main
  178. if answer = "V" then do
  179.  call cmt;verbose = 1;signal dl
  180. end
  181. if answer = "M" then do
  182.  call cmt;signal dl
  183. end;signal dlmenu
  184.  
  185. dl:
  186. call bl
  187. call open(file,mp||"BBSLIST",'W')
  188.  call writeln(file,"          List Created by BBS ROLODEX Version "||vers||" (c) 1993, 1994")
  189.  call writeln(file,"                         By: Larry Cloud")
  190.  call writeln(file,"")
  191.  call writeln(file,ll)
  192. call close(file)
  193. str =cls||wht||"Preparing your list. Stand by...";call out
  194. do number = 1 to 26
  195.  totalentry=0;call numbercv
  196.  if exists(ipth||letter||"/TOTAL") then do
  197.   call open(file,ipth||letter||"/total", 'R');totalentry = readln(file);call close(file)
  198.  end
  199.  if totalentry > 0 then do
  200.   do ch = 1 to totalentry
  201.    str=red||".";call msg;call readinfo
  202.    call open(file,mp||"BBSLIST",'A')
  203.     call writeln(file,"BBS NAME: "||BBSNAME.1)
  204.     if verbose = 1 then call writeln(file, "SYSOP NAME: "||SYSOPNAME.1)
  205.     if verbose = 1 then call writeln(file, "TOTAL NODES: "||NODES.1)
  206.     if nodes.1 > 6 then do
  207.      call writeln(file,"** ONLY 6 of the "||nodes.1||" will be listed **")
  208.      do flag = 1 to 6
  209.       call writeln(file,"NODE "||flag||": "||node.flag||"  BAUDS: "||minbaud.flag||" - "||maxbaud.flag)
  210.      end
  211.     end
  212.     if nodes.1 < 7 then do
  213.      do flag = 1 to nodes.1
  214.       call writeln(file,"NODE "||flag||": "||node.flag||"  BAUDS: "||minbaud.flag||" - "||maxbaud.flag)
  215.      end
  216.     end
  217.     if verbose = 1 then do
  218.      call writeln(file,"HOURS: "||HOURS.1);call writeln(file, "LOCATION: "||LOCATION.1)
  219.      call writeln(file,"SOFTWARE: "||SOFTWARE.1);call writeln(file, "STORAGE: "||STORAGE.1)
  220.      call writeln(file,"ONLINE GAMES: "||GAMES.1||"          FILE AREAS: "||FILES.1)
  221.      call writeln(file,"FIDONET SUPPORT: "||FIDONET.1||"      FIDONET ADDRESS: "||fad.1)
  222.      call writeln(file,"MAXNET SUPPORT: "||MAXNET.1||"      MAXNET ADDRESS: "||mad.1)
  223.     end
  224.     call writeln(file,"");call writeln(file, ""||COMMENTS.1);call writeln(file, ""||COMMENTS.2)
  225.     if verbose = 1 then do
  226.      call writeln(file,"INFORMATION BY: "||NAME.1||"   LAST UPDATE: "||DATE.1)
  227.     end
  228.     call writeln(file,ll);call close(file)
  229.    end
  230.   end
  231.  end
  232. drop verbose flag
  233. call lf2
  234. if compression ~="NONE" then do
  235.  str =cls||wht||"Creating archive...";call out
  236. end
  237. if exists(mp"BBSLIST.???") then do
  238.  address command "DELETE "||mp||"BBSLIST.??? QUIET"
  239. end
  240. do i=1 to 400;end
  241. address command "copy "||mp||"bbslist ram:"
  242. do i=1 to 900;end
  243. if compression = "LHA" then do
  244.  address command "LHA -2 a "||mp||"BBSLIST.LHA ram:bbslist > nil:"
  245.  call lf2
  246.  address command"DELETE "||mp||"BBSLIST QUIET"
  247.  FILEN = "BBSLIST.LHA"
  248. end
  249. if compression = "ZIP" then do
  250.  address command "ZIP "||mp||"BBSLIST.ZIP ram:BBSLIST > nil:"
  251.  call lf2
  252.  FILEN = "BBSLIST.ZIP"
  253. end
  254.  
  255. if compression = "UUE" then do
  256.  address command "UUXT a "||mp||"BBSLIST.UUE ram:BBSLIST > nil:"
  257.  call lf2
  258.  FILEN = "BBSLIST.UUE"
  259. end
  260.  
  261. if compression = "TXT" then do
  262.  call lf2
  263.  address command"rename "||mp||"BBSLIST "mp"BBSLIST.TXT"
  264. FILEN = "BBSLIST.TXT"
  265. end
  266. signal sndfl
  267.  
  268. sndfl:
  269. str = "File ready for download.";call out;str=mp||filen
  270. address command "delete ram:bbslist quiet"
  271. call SendBinFile dn,ln,str
  272. trash=result;call chcar;dlflag=1;call returnc;signal main
  273.  
  274. qsc:
  275. more = 0
  276. str =cls||cya||"This option will tell you HOW MANY CARDS are in each area.";call out
  277. str ="For more detailed lists do a VERBOSE or MINI-LIST read.";call out;call bl;str=wht||"Do you want to continue? (Y/n) > "
  278. call getkey;answer = upper(hot)
  279. if answer = "N" then do
  280.  str ="NO";call out;signal rmnu
  281. end
  282. str ="YES";call out;str =cls;call out
  283. do number = 1 to 27
  284.  temptotal=0;call numbercv
  285.  if exists(ipth||letter||"/TOTAL") then do
  286.   call open(file,ipth||letter||"/TOTAL", 'R');temptotal = readln(file);call close(file)
  287.   tx1="are ";if temptotal=1 then tx1="is "
  288.   tx2="s";if temptotal=1 then tx2=""
  289.   str =cya||"There "||tx1||red||temptotal||cya||" card"||tx2||" in "||red||letter;more = more + 1;call out
  290.   call morecheck
  291.   if break = 1 then do
  292.    drop break more
  293.    signal rmnu
  294.   end
  295.  end
  296.  if exists(dpth||letter) then do
  297.   call open(file,dpth||letter||"", "R")
  298.    do temp = 1 to temptotal
  299.     BBS = readln(file);bull = readln(file);str =grn||BBS;more = more + 1;call morecheck
  300.     if break = 1 then do
  301.      drop break more
  302.      call close(file)
  303.      signal rmnu
  304.     end
  305.    end
  306.   end
  307.  call close(file)
  308. end
  309. call returnc
  310. drop counter more
  311. signal rmnu
  312.  
  313. LETTERcv:
  314. number = c2d(letter)-64;if letter = "MISC" then number = 27
  315. return
  316.  
  317. NUMBERcv:
  318. letter = d2c(number+64);if NUMBER = 27 then LETTER = "MISC"
  319. return
  320.  
  321. rmnu:
  322. str =cls||sp||"          "||purbak||wht||"READ MENU"||nor;call out;call lf2
  323. str =str1||"V"||str2||" Verbose Read/Edit (All Info)";call out
  324. str =str1||"M"||str2||" Mini-List Read (Main Info)";call out
  325. str =str1||"N"||str2||" BBS Name Scan (Lists ONLY the Names)";call out
  326. str =str1||"S"||str2||" Search BBS ROLODEX w/Text string";call out
  327. str =str1||"Q"||str2||" Quit to Main Menu";call out;call lf2;call cardcount
  328. str=wht"Your Choice > ";call getkey;answer = upper(hot);str =answer;call out;call bl
  329. if answer = "N" then signal qsc
  330. if answer = "S" then signal smnu
  331. if answer = "V" then signal vmnu
  332. if answer = "M" then do
  333.  letter = "A";signal MINIMENU
  334. end
  335. if answer = "Q" then signal main
  336. signal rmnu
  337.  
  338. vmnu:
  339. number = 0;letter = "";ch = "";str =cls||cya||"What letter would you like to start with?";call out;call bl
  340. str=wht||"("||pur||"A"||wht||"-"||pur||"Z"||wht||"), "||pur||"@"||wht||" (SHIFT 2) for MISC, or "||pur||"!"||wht||" to QUIT) > "
  341. call getkey;letter = upper(hot);str =letter;call out;call bl
  342. if letter = "!" then signal rmnu
  343. tempcheck = c2d(letter);if tempcheck < 64 | tempcheck > 90 then do
  344.  call lf2;str =red||"Invalid Option!";call out;call returnc;signal rmnu
  345. end
  346. call lf2;str =red||"Searching..";call out
  347. if letter = "@" then letter = "MISC"
  348. call lettercv;call readentries;signal vbr
  349.  
  350. MINIMENU:
  351. continue=0;str =cls||cya||"Would you like a ("||pur||"C"||cya||")ONTINUOUS display or ("||pur||"P"||cya||")ause display?";call out
  352. call lf2;str =yel"Note: Continuous is only useful if you are doing a BUFFER CAPTURE!";call out
  353. str =grn||"Default is "||pur||"P"||grn||"ause";call out;call lf2;str=wht"Choice > "
  354. call getkey;answer = upper(hot);str=answer;call out
  355. if answer = "C" then do
  356.  continue = 1;call lf2;str=pur"Turn ON your CAPTURE BUFFER NOW.";call returnc
  357.  red = "";grnbak = "";yel = "";grn = "";wht = "";bla = "";nor = ""
  358. end
  359. call lettercv;call readentries;str =cls||red||ll;call out;counter = 0;more = 0;signal miniread
  360.  
  361. vbr:
  362. nuked=0;if totalentry<1 then signal nowwhat
  363. do ch = 1 to totalentry
  364.  if nuked=1 then signal vbr
  365.  cantfind=0;call readinfo
  366.  if cantfind=1 then signal nowwhat
  367.  call display
  368.  if SYSOP =upper(un) | un = NAME.1 then do
  369.   str=wht||"{"||pur||"D"||wht||"} to DELETE, {"||pur||"E"||wht;str=str||"} to EDIT, {"||pur||"Q"||wht||"} to QUIT, "||pur||"Any other key CONTINUES"||wht||" > ";call out;str=""
  370.   call getkey;answer = upper(hot);str=answer;call out
  371.   if answer = "D" then call DELETESTART
  372.   if answer = "E" then call eCARD
  373.   if answer = "Q" then SIGNAL rmnu
  374.  end
  375.  else do
  376.   str=wht||"{"||pur||"Q"||wht||"} to QUIT, "||pur||"Any other key CONTINUES"||wht||" > "
  377.   call getkey;answer = upper(hot);str=answer;call out
  378.   if answer = "Q" then SIGNAL rmnu
  379.  end
  380. end
  381.  
  382. nowwhat:
  383. if number < 26 then do
  384.  str=cls||cya||"Would you like to move to the NEXT letter? (Y/n) > "
  385.  call getkey;answer = upper(hot);if answer = "N" then signal rmnu
  386.  call lf2;str =red||"Searching..";call out;number = number + 1;call numbercv;call readentries;signal vbr
  387. end
  388. call lf2;str =grn||"No more entries...";call out;call returnc;signal rmnu
  389.  
  390. eCARD:
  391. call bl;str =red"{"grn"A"red"}"cya" BBS Name";call out;str =red"{"grn"B"red"}"cya" SYSOP Name";call out
  392. str =red"{"grn"C"red"}"cya" Node Information";call out;str =red"{"grn"D"red"}"cya" Hours of Operation";call out
  393. str =red"{"grn"E"red"}"cya" Location";call out;str =red"{"grn"F"red"}"cya" BBS Software";call out
  394. str =red"{"grn"G"red"}"cya" Computers Supported";call out;str =red"{"grn"H"red"}"cya" Total Storage"
  395. call out;str =red"{"grn"I"red"}"cya" FIDO/MAXNET/GAMES/FILES Info";call out;str =red"{"grn"J"red"}"cya" Comments"
  396. call out;call bl;str=wht"Edit which field? > "
  397. call getkey;answer = upper(hot)
  398. if answer = "A" then do
  399.  call lf2;str =red"To edit the NAME of the BBS requires you to DELETE the entire card and";call out;str ="re-enter it.";call out
  400.  ch = ch - 1;call returnc
  401.  return
  402. end
  403. if answer = "B" then call esysopname;if answer = "C" then call enodes;if answer = "D" then call ehours
  404. if answer = "E" then call elocation;if answer = "F" then call eBBSSOFTWARE;if answer = "G" then call eCOMPUTERS
  405. if answer = "H" then call eSTORAGE;if answer = "I" then call efidoinfo;if answer = "J" then call ecomments
  406. ch = ch - 1;return
  407.  
  408. eNODES:
  409. str=cls;call out
  410. if NODES.1 > 6 then do
  411.  do LOOP = 1 to 6
  412.   nowinfo.loop = "Node "loop": "NODE.loop" Baud Rates: "MINBAUD.loop" - "MAXBAUD.loop
  413.  end
  414.  totallines = 6
  415. end
  416. else do
  417.  if nodes.1 < 7 then do
  418.   do loop = 1 to nodes.1
  419.    nowinfo.loop = "Node "loop": "NODE.loop" Baud Rates: "MINBAUD.loop" - "MAXBAUD.loop
  420.   end
  421.   totallines = nodes.1
  422.  end
  423. end
  424. call emessage
  425. drop totallines
  426. call lf2;call returnc;str =red"Standby..";call out;call bl;call phonedelete;call NODEINPT
  427. if breakloop = 1 then do
  428.  breakloop = 0;call readinfo
  429. end
  430. if dupefail = 1 then do
  431.  drop dupefail;breakloop = 0;call readinfo
  432. end
  433. tempnodes = NODES.1;call writephone;call writeeinfo;return
  434.  
  435. eFIDOINFO:
  436. str=cls;call out
  437. nowinfo.1 = "Offers Fidonet     : "FIDONET.1
  438. nowinfo.2 = "Fidonet Address    : "fad.1
  439. nowinfo.3 = "Offers Maxnet      : "MAXNET.1
  440. nowinfo.4 = "Maxnet Address     : "mad.1
  441. nowinfo.5 = "Offers Online Games: "GAMES.1
  442. nowinfo.6 = "Has File Areas     : "FILES.1
  443. totallines = 6
  444. call emessage
  445. drop totallines
  446. call lf2
  447. str =grn"The following 4 questions require a ONE LETTER ANSWER!";call out
  448. str =pur"Y"grn" means "pur"YES"grn", "pur"N"grn;str=str" means "pur"NO"grn", "pur"U"grn" means ";str=strpur"UNKNOWN."grn" DEFAULT is UNKNOWN.";call out
  449. str ="HOTKEY mode is ACTIVATED so you DO NOT have to press RETURN.";call out;call lf2
  450. call FIDOqu;call MAXNETqu;call GAMESqu;call FILESqu;call writeeinfo;return
  451.  
  452. eCOMMENTS:
  453. str=cls;call out;width = 76;tempwidth = width - 1;nobl = 0;blTEXT = "NO COMMENTS";LINE = 1;totallines = 2
  454. limitedtext.1 = pet"COMMENTS ABOUT THE BBS"peu||tempwidth||pev;limitedprompt.1 = "1> "
  455. limitedtext.2 = "";limitedprompt.2 = "2> ";drop tempwidth
  456. call bl;nowinfo.1 = COMMENTS.1;nowinfo.2 = COMMENTS.2;call emessage;call limitedwidth
  457. COMMENTS.1 = ENTRY.1;COMMENTS.2 = ENTRY.2;if breakloop = 1 then do
  458.  breakloop = 0;return
  459. end;call writeeinfo;return
  460.  
  461. eSTORAGE:
  462. str=cls;call out;width = 70;tempwidth = width - 1;nobl = 0;blTEXT = "Unknown";LINE = 1;totallines = 1
  463. limitedtext.1 = pet"TOTAL HARD DRIVE STORAGE AVAILABLE"peutempwidth||pev;limitedprompt.1 = "1> ";drop tempwidth
  464. call bl;nowinfo.1 = STORAGE.1;call emessage;call limitedwidth;STORAGE.1 = ENTRY.1
  465. if breakloop = 1 then do
  466.  breakloop = 0;return
  467. end;call writeeinfo;return
  468.  
  469. eCOMPUTERS:
  470. str=cls;call out;width = 61;tempwidth = width - 1;nobl = 0;blTEXT = "Unknown";LINE = 1;totallines = 1
  471. limitedtext.1 = pet"COMPUTERS SUPPORTED ON THIS BBS"peu||tempwidth||pev;limitedprompt.1 = "1> ";drop tempwidth;call bl
  472. nowinfo.1 = SUPPORT.1;call emessage;call limitedwidth;SUPPORT.1 = ENTRY.1
  473. if breakloop = 1 then do
  474.  breakloop = 0;return
  475. end;call writeeinfo;return
  476.  
  477. eBBSSOFTWARE:
  478. str=cls;call out;width = 65;tempwidth = width - 1;nobl = 0;blTEXT = "Unknown";LINE = 1;totallines = 1
  479. limitedtext.1 = pet"NAME OF THE BBS SOFTWARE"peu||tempwidth||pev;limitedprompt.1 = "1> ";drop tempwidth;call bl
  480. nowinfo.1 = SOFTWARE.1;call emessage;call limitedwidth;SOFTWARE.1 = ENTRY.1
  481. if breakloop = 1 then do
  482.  breakloop = 0;return
  483. end;call writeeinfo;return
  484.  
  485. eLOCATION:
  486. str=cls;call out;width = 69;tempwidth = width - 1;nobl = 0;blTEXT = "Unknown";LINE = 1;totallines = 1
  487. limitedtext.1 = pet"LOCATION (CITY, STATE)"peu||tempwidth||pev;limitedprompt.1 = "1> ";drop tempwidth;call bl
  488. nowinfo.1 = LOCATION.1;call emessage;call limitedwidth;LOCATION.1 = ENTRY.1
  489. if breakloop = 1 then do
  490.  breakloop = 0;return
  491. end;call writeeinfo;return
  492.  
  493. eHOURS:
  494. str=cls
  495. call out
  496. width = 72
  497. tempwidth = width - 1
  498. nobl = 0
  499. blTEXT = "Unknown"
  500. LINE = 1
  501. totallines = 1
  502. limitedtext.1 = pet"HOURS AVAILABLE"peu||tempwidth||pev
  503. limitedprompt.1 = "1> "
  504. drop tempwidth
  505. call bl
  506. nowinfo.1 = HOURS.1
  507. call emessage
  508. call limitedwidth
  509. HOURS.1 = ENTRY.1
  510. if breakloop = 1 then do
  511.  breakloop = 0
  512.  return
  513. end
  514. call writeeinfo
  515. return
  516.  
  517. eSYSOPNAME:
  518. str=cls
  519. call out
  520. width = 67
  521. tempwidth = width - 1
  522. nobl = 0
  523. blTEXT = "Unknown"
  524. LINE = 1
  525. totallines = 1
  526. limitedtext.1 = pet"NAME OF THE SYSOP"peu||tempwidth||pev
  527. limitedprompt.1 = "1> "
  528. drop tempwidth
  529. call bl
  530. nowinfo.1 = SYSOPNAME.1
  531. call emessage
  532. call limitedwidth
  533. SYSOPNAME.1 = ENTRY.1
  534. if breakloop = 1 then do
  535.  breakloop = 0
  536.  return
  537. end
  538. call writeeinfo
  539. return
  540.  
  541. eMESSAGE:
  542. str=cls
  543. call out
  544. str =grn"You will have to re-enter the information for this field. The information"
  545. call out
  546. str ="now reads:"yel
  547. call out
  548. do tempinfo = 1 to totallines
  549.  str =nowinfo.tempinfo
  550.  call out
  551. end
  552. call bl
  553. return
  554.  
  555. DELETESTART:
  556. str =cls
  557. call out
  558. if sysop = un | name.1 = un then do
  559.  str=cya"Are you sure you want to delete this card? (y/N) > "
  560.  call getkey
  561.  answer = upper(hot)
  562.  str=answer
  563.  call out
  564.  if answer = "Y" then do
  565.   call deleteCARD
  566.   nuked=1
  567.  end
  568.  drop answer tempone temptwo tnumber tname temploop index tempnum newnum totalphones
  569.  return
  570. end
  571. return
  572.  
  573. DELETECARD:
  574. str =cls||grn"This may take a little while depending on the amount of cards in the area!"red
  575. call out
  576. str ="Deleting Card.."
  577. call out
  578. address command"DELETE "ipth||LETTER"/"LETTER"."ch" QUIET"
  579. str ="Reindexing Cards.."
  580. call out
  581. call bl
  582. call bl
  583. str="This would be a good time to fill out your registration card (WINDOZE HUMOR)"
  584. call out
  585. call bl
  586. totalindx=0
  587. if exists(ipth||letter||"/TOTAL") then do
  588.  call open(file, ipth||letter"/TOTAL", 'R')
  589.   totalINDX = readln(file)
  590.  call close(file)
  591. end
  592. call PHONEDELETE
  593. totalcards=0
  594. if totalindx < 1 then do
  595.  call open(file, ipth||letter"/TOTAL", 'W')
  596.   call writeln(file, "0")
  597.  call close(file)
  598.  if exists(dpth"TOTAL") then do
  599.   call open(file, dpth"total", 'R')
  600.    totalcards = readln(file)
  601.   call close(file)
  602.  end
  603.   totalcards = totalcards - 1
  604.  if totalcards < 1 then totalcards = 0
  605.  call open(file, dpth"total", 'W')
  606.   call writeln(file, totalcards)
  607.  call close(file)
  608.  call open(file, dpth||letter, "W")
  609.  call close(file)
  610.  return
  611. end
  612. call DATADELETE
  613. ttnumber = ch + 1
  614. do INDEX = ttnumber to totalindx
  615.  tnumber = INDEX - 1
  616.  address command"RENAME "ipth||LETTER"/"LETTER"."index" AS "ipth||LETTER"/"LETTER"."tnumber
  617. end
  618. totalindx = totalindx - 1
  619. if totalindx < 1 then totalindx=0
  620. call open(file, ipth||LETTER"/TOTAL", 'W')
  621.  call writeln(file, totalINDX)
  622. call close(file)
  623. totalcards=0
  624. if exists(dpth"TOTAL") then do
  625.  call open(ttfile, dpth"TOTAL", 'R')
  626.   totalcards = readln(ttfile)
  627.  call close(ttfile)
  628. end
  629. totalcards = totalcards - 1
  630. if totalcards < 1 then totalcards = 0
  631. call open(tttfile, dpth"TOTAL", 'W')
  632.  call writeln(tttfile, totalcards)
  633. call close(tttfile)
  634. call returnc
  635. check=0
  636. if exists(ipth||letter"/TOTAL") then do
  637.  call open(file, ipth||letter"/total", 'R')
  638.   check = readln(file)
  639.  call close(file)
  640. end
  641. if check = 0 then do
  642.  call bl
  643.  str =red"No more entries in this area!"
  644.  call out
  645.  call returnc
  646. end
  647. return
  648.  
  649. PHONEDELETE:
  650. totalphones=0
  651. if exists(mp"phones/total") then do
  652.  call open(file, mp"PHONES/TOTAL", 'R')
  653.   totalphones = readln(file)
  654.  call close(file)
  655. end
  656. ttotalphones = totalphones
  657. call open(tfile, mp"PHONES/TNUMBERS", "W")
  658.  call open(file, mp"PHONES/NUMBERS", "R")
  659.   do temploop = 1 to totalphones
  660.    tempone = readln(file)
  661.    if tempone = NODE.1 | tempone = NODE.2 | tempone = NODE.3 | tempone = NODE.4 | tempone = NODE.5 | tempone = NODE.6 then do
  662.     tempone = ""
  663.     if ttotalphones > 1 then do
  664.      ttotalphones = ttotalphones - 1
  665.     end
  666.     else do
  667.      ttotalphones = 0
  668.     end
  669.    end
  670.    call writeln(tfile, tempone)
  671.   end
  672.  call close(file)
  673. call close(tfile)
  674. call open(file, mp"PHONES/TNUMBERS", "R")
  675.  call open(tfile, mp"PHONES/NUMBERS", "W")
  676.   do temploop = 1 to totalphones
  677.    tempone = readln(file)
  678.    if tempone ~= "" then do
  679.     call writeln(tfile, tempone)
  680.    end
  681.   end
  682.  call close(file)
  683. call close(tfile)
  684. call open(file, mp"PHONES/TOTAL", "W")
  685.  call writeln(file, ttotalphones)
  686. call close(file)
  687. drop ttotalphones
  688. address command"DELETE "mp"PHONES/TNUMBERS QUIET"
  689. return
  690.  
  691. DATADELETE:
  692. call open(tfile, mp"ROLOtemp", "W")
  693.  call open(file, dpth||letter, "R")
  694.   do TEMPLOOP = 1 to TOTALINDX
  695.    tempone = readln(file)
  696.    temptwo = readln(file)
  697.    if temptwo = letter"."ch then do
  698.     tempone = ""
  699.     temptwo = ""
  700.    end
  701.    call writeln(tfile, tempone)
  702.    call writeln(tfile, temptwo)
  703.   end
  704.  call close(file)
  705. call close(tfile)
  706. do i=1 to 800;end
  707. call open(file, mp"ROLOtemp", "R")
  708.  call open(tfile, mp"ROLOfinal", "W")
  709.   do temploop = 1 to totalindx
  710.    tempone = readln(file)
  711.    temptwo = readln(file)
  712.    if temptwo = "" then do
  713.     tempone = readln(file)
  714.     temptwo = readln(file)
  715.     tempnum = ch + 1
  716.     do TINDEX = tempnum to totalindx
  717.      newnum = tindex - 1
  718.      call writeln(tfile, tempone)
  719.      call writeln(tfile, letter"."newnum)
  720.      tempone = readln(file)
  721.      temptwo = readln(file)
  722.     end
  723.     temploop = totalindx
  724.    end
  725.    else do
  726.     call writeln(tfile, tempone)
  727.     call writeln(tfile, temptwo)
  728.    end
  729.   end
  730.  call close(file)
  731. call close(tfile)
  732. address command"rename "mp"ROLOfinal "mp||LETTER" > nil:"
  733. address command"COPY "mp||LETTER" "dpth||LETTER" > nil:"
  734. address command"DELETE "mp||LETTER" QUIET"
  735. address command"DELETE "mp"ROLOtemp QUIET"
  736. call open(file, ipth||LETTER"/TOTAL", "R")
  737.  ttotalINDX = readln(file)
  738. call close(file)
  739. ttotalindx = ttotalindx - 1
  740. call open(file, ipth||LETTER"/TOTAL", "W")
  741.  call writeln(file, ttotalINDX)
  742. call close(file)
  743. drop ttotalindx
  744. return
  745.  
  746. MINIREAD:
  747. if continue ~= 1 then do
  748.  do ch = 1 to totalentry
  749.   call readinfo
  750.   call minidisplay
  751.   if break = 1 then do
  752.    drop break ch
  753.    signal rmnu
  754.   end
  755.  end
  756. end
  757. else do
  758.  do ch = 1 to totalentry
  759.   call readinfo
  760.   call minidisplay
  761.  end
  762. end
  763. if number < 26 then do
  764.  number = number + 1
  765.  call numbercv
  766.  call readentries
  767.  signal MINIread
  768. end
  769. if continue ~= 1 then do
  770.  call bl
  771.  str=pur"End of list."
  772.  call returnc
  773.  call getkey
  774.  drop more counter
  775. end
  776. if continue = 1 then do
  777.  drop continue
  778.  call lf2
  779.  bla = ""
  780.  red = ""
  781.  grn = ""
  782.  yel = ""
  783.  wht = ""
  784.  grnbak = ""
  785.  nor = ""
  786.  str=pur"List Complete. Turn OFF your capture buffer."
  787.  call returnc
  788. end
  789. signal rmnu
  790.  
  791. READENTRIES:
  792. totalentry=0
  793. if exists(ipth||letter"/total") then do
  794.  call open(file, ipth||letter"/total", "R")
  795.   totalentry = readln(file)
  796.  call close(file)
  797. end
  798. if totalentry < 1 & number < 27 then do
  799.  number = number + 1
  800.  call numbercv
  801.  signal readentries
  802. end
  803. else do
  804. return
  805. end
  806.  
  807. smnu:
  808. totalf = 0
  809. str = cls
  810. call out
  811. str =sp"       "purbak||wht"SEARCH BBS ROLODEX"nor
  812. call out
  813. call lf2
  814. abt="All BBS's that offer"
  815. str =str1"A"str2" Specific AREA CODE Search"
  816. call out
  817. str =str1"F"str2" "abt" FIDONET"
  818. call out
  819. str =str1"M"str2" "abt" MAXNET"
  820. call out
  821. str =str1"O"str2" "abt" ONLINE GAMES"
  822. call out
  823. str =str1"S"str2" "abt" FILE SECTIONS"
  824. call out
  825. str =str1"T"str2" Search ALL fields with TEXT string"
  826. call out
  827. str =str1"Q"str2" Quit to Main Menu"
  828. call out
  829. call lf2
  830. str="NOTE: AREA CODE is the leftmost digits in a phone number"
  831. call out
  832. call lf2
  833. call cardcount
  834. str=wht"Your Choice > "
  835. call getkey
  836. inpt = upper(hot)
  837. str=inpt
  838. call out
  839. call bl
  840. if inpt = "A" then do
  841.  str=cls
  842.  call out
  843.  str=cya"What area code do you want to find? > "
  844.  length=9
  845.  call input
  846.  answer = upper(typed)
  847.  singlesearch = 1
  848.  signal searchcounter
  849. end
  850. if inpt = "Q" then do
  851.  signal main
  852. end
  853. if inpt = "T" then do
  854.  signal search
  855.  end
  856. if inpt = "F" then do
  857.  singlesearch = 1
  858.  answer = "YES"
  859.  signal searchcounter
  860. end
  861. if inpt = "M" then do
  862.  singlesearch = 1
  863.  answer = "YES"
  864.  signal searchcounter
  865. end
  866. if inpt = "O" then do
  867.  singlesearch = 1
  868.  answer = "YES"
  869.  signal searchcounter
  870. end
  871. if inpt = "S" then do
  872.  singlesearch = 1
  873.  answer = "YES"
  874.  signal searchcounter
  875. end
  876. signal smnu
  877.  
  878. SEARCH:
  879. singlesearch=0
  880. drop answer
  881. str =cls||cya"This option allows you to search for a ROLODEX CARD by entering a"
  882. call out
  883. str ="TEXT string. This will search for an EXACT or PARTIAL match of your entry!"
  884. call out
  885. str ="If you enter 'IN' you might get a match like 'busINess' so try to be"
  886. call out
  887. str ="a little specific. WILDCARD PATTERNS ARE NOT SUPPORTED (I.E. BUSIN*) "
  888. call out
  889. str ="The search is NOT CASE SENSITIVE.  I have also disabled it 'FINDING' a"
  890. call out
  891. str ="match in the following fields:"
  892. call out
  893. call bl
  894. str="ALL phone number entries, Fido/Maxnet addresses, Whether or not they have"
  895. call out
  896. str="Fidonet, Maxne,t Doors, Files, Online Games, and the Modified by fields."
  897. call out
  898. call bl
  899. call bl
  900. str=wht"Please enter your search string (RETURN TO ABORT) > "
  901. length=78
  902. call input
  903. answer = upper(typed)
  904. if answer = "NULL" then signal smnu
  905. signal searchcounter
  906.  
  907. SEARCHCOUNTER:
  908. totalf = 0
  909. answer = space(ANSWER,1,"_")
  910. letter="A"
  911. letter = c2d(letter)
  912. call bl
  913. str =cya"Searching "TOTALCARDS" cards:"
  914. call out
  915. call bl
  916. str =red"1...5....10...15...20...25...30...35...40...45...50...55...60...65...70...75..."
  917. call out
  918. call bl
  919. str =ll
  920. call out
  921. signal searchsub
  922.  
  923. SEARCHSUB:
  924. do tch = 65 to 90 
  925.  letter = d2c(tch)
  926.  totalarea=0
  927.  if exists(ipth||letter"/total") then do
  928.   call open(file, ipth||letter"/total", "R")
  929.    totalarea = readln(file)
  930.   call close(file)
  931.   call searchmain
  932.  end
  933. end
  934. letter = "MISC"
  935. totalarea=0
  936.  if exists(ipth||letter"/total") then do
  937.   call open(file, ipth||letter"/total", "R")
  938.    totalarea = readln(file)
  939.   call close(file)
  940.   call searchmain
  941.  end
  942. tmtch="Match"
  943. if totalf > 1 then tmtch="Matches"
  944. if totalf > 0 then do
  945.  call bl
  946.  call bl
  947.  str =red||totalf" "tmtch" Found."
  948.  call out
  949.  str =""cya
  950.  call out
  951.  tx1=""
  952.  if totalf>1 then tx1="s"
  953.  str="Would you like to view matched card"tx1"? (Y/n) > "
  954.  call getkey
  955.  answer = upper(hot)
  956.  str = answer
  957.  call out
  958.  if answer = "N" then do
  959.   flag = totalf
  960.   do flag = 1 to totalf
  961.    drop found.flag
  962.   end
  963.   drop tvar flag searchval
  964.   totalf = 0
  965.   signal smnu
  966.  end
  967.  do flag = 1 to totalf
  968.   ch=right(found.flag,2)
  969.   if left(ch,1)="." then ch=right(ch,1)
  970.   tvar = left(found.flag,4)
  971.   tvar = upper(tvar)
  972.   if tvar = "MISC" then do
  973.    letter = "MISC"
  974.    searchreadinfo = 1
  975.    call readinfo
  976.    drop searchreadinfo
  977.    call display
  978.   end
  979.   else do
  980.    tvar = left(found.flag,1)
  981.    tvar = upper(tvar)
  982.    letter = tvar
  983.    searchreadinfo = 1
  984.    call readinfo
  985.    drop searchreadinfo
  986.    call display
  987.   end
  988.   str=pur"Continue display? (Y/n) > "
  989.   call getkey
  990.   answer = upper(hot)
  991.   if answer = "N" then flag = totalf
  992.  end
  993.  do flag = 1 to totalf
  994.   drop found.flag
  995.  end
  996. end
  997. else do
  998.  call out
  999.  call bl
  1000.  str =red"SORRY, NO MATCHES FOUND!!"
  1001.  call out
  1002.  call returnc
  1003.  str=cls||nor
  1004.  call out
  1005. end
  1006. drop tvar searchval
  1007. totalf = 0 
  1008. str=cls||nor
  1009. call out
  1010. signal smnu
  1011.  
  1012. SEARCHMAIN:
  1013. if totalarea < 1 then return
  1014. if singlesearch = 1 then do
  1015.  do ch = 1 to totalarea
  1016.   str=cya"."
  1017.   call msg
  1018.   call READINFO
  1019.   if inpt = "F" then PASSNAME.1 = FIDONET.1
  1020.   if inpt = "M" then PASSNAME.1 = MAXNET.1
  1021.   if inpt = "O" then PASSNAME.1 = GAMES.1
  1022.   if inpt = "S" then PASSNAME.1 = FILES.1
  1023.   if inpt = "A" then do
  1024.    do flag = 1 to 6
  1025.     passname.1 = NODE.FLAG;cv.1 = passname.1;call searchcv;PASSNAME.1 = cv.1;call sch
  1026.    end
  1027.   end
  1028.   if inpt ~= "A" then do
  1029.    cv.1 = PASSNAME.1;call searchcv;PASSNAME.1 = cv.1;call sch
  1030.   end
  1031.  end
  1032.  drop cv.1;return
  1033. end
  1034. else do
  1035.  do ch = 1 to totalarea
  1036.   str=cya".";call msg;call READINFO;cv.1 = BBSNAME.1;call searchcv;BBSNAME.1 = cv.1;call sch
  1037.   cv.1 = SYSOPNAME.1;call searchcv;SYSOPNAME.1 = cv.1;call sch;cv.1 = LOCATION.1;call searchcv
  1038.   LOCATION.1 = cv.1;call sch;cv.1 = SOFTWARE.1;call searchcv;SOFTWARE.1 = cv.1;call sch
  1039.   cv.1 = SUPPORT.1;call searchcv;SUPPORT.1 = cv.1;call sch;cv.1 = STORAGE.1;call searchcv
  1040.   STORAGE.1 = cv.1;call sch;cv.1 = COMMENTS.1;call searchcv;COMMENTS.1 = cv.1;call sch
  1041.   cv.1 = COMMENTS.2;call searchcv;COMMENTS.2 = cv.1;call sch;cv.1 = DATE.1;call searchcv
  1042.   DATE.1 = cv.1;call sch
  1043.  end;drop cv.1;return
  1044. end
  1045.  
  1046. searchcv:
  1047. cv.1 = upper(cv.1)
  1048. cv.1 = space(cv.1,1,"_")
  1049. SEARCHVAL = POS(ANSWER,cv.1)
  1050. if inpt = "A" then do
  1051.  if searchval > 1 then searchval = 0
  1052. end
  1053. return
  1054.  
  1055. sch:
  1056. if searchval > 0 then do
  1057.  totalf = totalf + 1
  1058.   tfound.totalf = letter"."ch
  1059.  do tflag = 1 to totalf
  1060.   if tfound.totalf = found.tflag then do
  1061.    totalf = totalf - 1
  1062.    returnv = 1
  1063.   end
  1064.  end
  1065.  if returnv = 1 then do
  1066.   returnv = 0
  1067.   return
  1068.  end
  1069.  else do
  1070.  found.totalf = tfound.totalf
  1071.  drop tflag tfound.totalf 
  1072.  end
  1073. end
  1074. return
  1075.  
  1076. MAKE:
  1077. line = 0
  1078. str =cls||cya"This option will allow you to make a NEW entry in the BBS ROLODEX."
  1079. call out
  1080. str ="Here is a SAMPLE CARD with instructions on what you can expect."
  1081. call out
  1082. call returnc
  1083. call bl
  1084. call readgra dn,ln,mp"text/EXAMPLE"
  1085. call returnc
  1086. str =cls||sp"  "purbak||wht"Make a BBS ROLODEX CARD"nor
  1087. call out
  1088. call bl
  1089. width = 69
  1090. tempwidth = width - 1
  1091. nobl = 1
  1092. bltext = "Unknown"
  1093. call out
  1094. totallines = 1
  1095. limitedtext.1 = pet"NAME OF BBS"peu||tempwidth||pev
  1096. limitedprompt.1 = "1> "
  1097. drop tempwidth
  1098. call limitedwidth
  1099. if breakloop = 1 then do
  1100.  breakloop = 0
  1101.  signal main
  1102. end
  1103. BBSNAME.1 = ENTRY.1
  1104. tq=upper(left(bbsname.1,1))||right(bbsname.1,length(bbsname.1)-1)
  1105. bbsname.1=tq
  1106. str=cls
  1107. call out
  1108. width = 67
  1109. tempwidth = width - 1
  1110. nobl = 0
  1111. blTEXT = "Unknown"
  1112. LINE = 1
  1113. totallines = 1
  1114. limitedtext.1 = pet"NAME OF THE SYSOP"peu||tempwidth||pev
  1115. limitedprompt.1 = "1> "
  1116. drop tempwidth
  1117. call bl
  1118. call limitedwidth
  1119. SYSOPNAME.1 = ENTRY.1
  1120. if breakloop = 1 then do
  1121.  breakloop = 0
  1122.  signal main
  1123. end
  1124. do flag = 1 to 6
  1125.  NODE.FLAG = ""
  1126.  MINBAUD.FLAG = ""
  1127.  MAXBAUD.FLAG = ""
  1128. end
  1129. call NODEINPT
  1130. if breakloop = 1 then do
  1131.  breakloop = 0
  1132.  signal main
  1133. end
  1134. if dupefail = 1 then do
  1135.  drop dupefail
  1136.  breakloop = 0
  1137.  signal main
  1138. end
  1139. str=cls
  1140. call out
  1141. width = 72
  1142. tempwidth = width - 1
  1143. nobl = 0
  1144. bltext = "Unknown"
  1145. LINE = 1
  1146. totallines = 1
  1147. limitedtext.1 = pet"HOURS OF OPERATION"peu||tempwidth||pev
  1148. limitedprompt.1 = "1> "
  1149. drop tempwidth
  1150. str = ""
  1151. call limitedwidth
  1152. HOURS.1 = ENTRY.1
  1153. if breakloop = 1 then do
  1154.  breakloop = 0
  1155.  signal main
  1156. end
  1157. str=cls
  1158. call out
  1159. width = 69
  1160. tempwidth = width - 1;if tempwidth < 1 then tempwidth=1
  1161. nobl = 0
  1162. bltext = "Unknown"
  1163. LINE = 1
  1164. totallines = 1
  1165. limitedtext.1 = pet"LOCATION (CITY, STATE)"peu||tempwidth||pev
  1166. limitedprompt.1 = "1> "
  1167. drop tempwidth
  1168. str = ""
  1169. call limitedwidth
  1170. LOCATION.1 = ENTRY.1
  1171. if breakloop = 1 then do
  1172.  breakloop = 0
  1173.  signal main
  1174. end
  1175. str=cls
  1176. call out
  1177. width = 65
  1178. tempwidth = width - 1
  1179. nobl = 0
  1180. blTEXT = "Unknown"
  1181. LINE = 1
  1182. totallines = 1
  1183. limitedtext.1 = pet"NAME OF THE BBS SOFTWARE"peu||tempwidth||pev
  1184. limitedprompt.1 = "1> "
  1185. drop tempwidth
  1186. str = ""
  1187. call limitedwidth
  1188. SOFTWARE.1 = ENTRY.1
  1189. if breakloop = 1 then do
  1190.  breakloop = 0
  1191.  signal main
  1192. end
  1193. str=cls
  1194. call out
  1195. width = 61
  1196. tempwidth = width - 1
  1197. nobl = 0
  1198. blTEXT = "Unknown"
  1199. LINE = 1
  1200. totallines = 1
  1201. limitedtext.1 = pet"COMPUTERS SUPPORTED ON THIS BBS"peu||tempwidth||pev
  1202. limitedprompt.1 = "1> "
  1203. drop tempwidth
  1204. str = ""
  1205. call limitedwidth
  1206. SUPPORT.1 = ENTRY.1
  1207. if breakloop = 1 then do
  1208.  breakloop = 0
  1209.  signal main
  1210. end
  1211. str=cls
  1212. call out
  1213. width = 70
  1214. tempwidth = width - 1
  1215. nobl = 0
  1216. bltext = "Unknown"
  1217. LINE = 1
  1218. totallines = 1
  1219. limitedtext.1 = pet"TOTAL HARD DRIVE STORAGE AVAILABLE"peu||tempwidth||pev
  1220. limitedprompt.1 = "1> "
  1221. drop tempwidth
  1222. str = ""
  1223. call limitedwidth
  1224. STORAGE.1 = ENTRY.1
  1225. if breakloop = 1 then do
  1226.  breakloop = 0
  1227.  signal main
  1228. end
  1229. str =cls||grn"The following 4 questions require a ONE LETTER ANSWER!"
  1230. call out
  1231. str =pur"Y"grn" means "pur"YES"grn", "pur"N"grn" means "pur"NO"grn", "pur"U"grn" means "pur"UNKNOWN."grn" DEFAULT is UNKNOWN."
  1232. call out
  1233. str ="HOTKEY mode is ACTIVATED so you DO NOT have to press RETURN."
  1234. call out
  1235. call lf2
  1236. call FIDOqu
  1237. call MAXNETqu
  1238. call GAMESqu
  1239. call FILESqu
  1240. str=cls
  1241. call out
  1242. width = 76
  1243. tempwidth = width - 1
  1244. nobl = 0
  1245. blTEXT = "NO COMMENTS"
  1246. LINE = 1
  1247. TOTALLINES = 2
  1248. LIMITEDTEXT.1 = pet"COMMENTS ABOUT THE BBS"||peu||tempwidth||pev
  1249. LIMITEDPROMPT.1 = "1> "
  1250. LIMITEDTEXT.2 = ""
  1251. LIMITEDPROMPT.2 = "2> "
  1252. drop tempwidth
  1253. call bl
  1254. call limitedwidth
  1255. COMMENTS.1 = ENTRY.1
  1256. COMMENTS.2 = ENTRY.2
  1257. if breakloop = 1 then do
  1258.  breakloop = 0
  1259.  signal main
  1260. end
  1261. NAME.1 = un
  1262. DATE.1 = DATE(U)
  1263. call firstletter
  1264. call display
  1265. str=wht"Is this information correct (Y/n) > "
  1266. call getkey
  1267. answer = upper(hot)
  1268. if answer = "N" then do
  1269.  str="NO"
  1270.  call out
  1271.  call bl
  1272.  str =red"Aborting Entry!"
  1273.  call out
  1274.  call returnc
  1275.  drop answer
  1276.  signal main
  1277. end
  1278. str="YES"
  1279. call out
  1280. drop answer
  1281. call lf2
  1282. str ="Storing "pur||BBSNAME.1||red" in "pur||upper(letter)||red".."nor
  1283. call out
  1284. call writeinfo
  1285. call writephone
  1286. call returnc
  1287. call sortentries
  1288. signal main
  1289.  
  1290. eORINSTRUCT:
  1291. do flag = 1 to totallines
  1292.  eORINS.flag = ""
  1293. end
  1294. eORINS1.1 = wht"Editor Commands: All Commands preceded by '/'."
  1295. eORINS2.1 = "/A aborts, /? for a full list of commands."
  1296. eORINS3.1 = "Word Wrap NOT supported. Press RETURN after EACH line!"
  1297. eORINS4.1 = "If you have no entry for this field, PRESS RETURN ON ALL LINES!"
  1298. eORINS5.1 = pur"PRESS RETURN ON ANY REMAINING LINES TO SAVE!"wht
  1299. if totallines = 1 then do
  1300.  eORINS6.1 = "There is 1 line available."
  1301. end
  1302. else do
  1303.  eORINS6.1 = "There are "totallines" lines available."
  1304. end
  1305. return
  1306.  
  1307. LIMITEDWIDTH:
  1308. do clear = 1 to totallines
  1309.  entry.clear = ""
  1310. end
  1311. do clear = 1 to width
  1312.  try.clear = ""
  1313. end
  1314. drop clear
  1315. do line = 1 to totallines
  1316.  drop clear
  1317.  str =limitedtext.line;call out;call eorinstruct
  1318.  if line = 1 then do
  1319.   str =eorins1.line;call out;str =eorins2.line;call out;str =eorins3.line;call out;str =eorins4.line;call out;str =eorins5.line;call out;str =eorins6.line;call bl
  1320.  end
  1321.  call bl
  1322.  str=wht||limitedprompt.line
  1323.  call msg
  1324.  do cursor = 1 to width
  1325.   breakloop = 0
  1326.   breakfield = 0
  1327.   str=""
  1328.   call getkey
  1329.   TRY.cursor = hot
  1330.   call checkentry
  1331.   if break = 1 then do
  1332.    drop break
  1333.    str=cls
  1334.    call out
  1335.    signal limitedwidth
  1336.   end
  1337.   if clear = 1 then break
  1338.   if breakloop = 1 then do
  1339.    if breakfield = 1 then do
  1340.     breakloop = 0
  1341.    end
  1342.    return
  1343.   end
  1344.   if backspace = 3 then do
  1345.    backspace = 0
  1346.    cursor = 0
  1347.    comparefail = 1
  1348.    do clear = 1 to width
  1349.     try.clear = ""
  1350.    end
  1351.    drop clear
  1352.   end
  1353.   if backspace = 1 then do
  1354.    backspace = 0
  1355.    str=try.cursor
  1356.    call msg
  1357.    cursor = cursor - 2
  1358.    comparefail = 1
  1359.   end
  1360.   if comparefail = 0 then do
  1361.    str=try.cursor
  1362.    call msg
  1363.   end
  1364.  end
  1365.  entry.LINE = try.1
  1366.  do overloop  = 2 to width
  1367.   ENTRY.LINE = overlay(try.overloop,entry.LINE,overloop)
  1368.  end
  1369.  ENTRY.LINE = strip(ENTRY.LINE,"T")
  1370.  if nobl = 1 then do
  1371.   if entry.LINE = "" then do
  1372.    call lf2
  1373.    str =red"This entry CAN NOT be left blank!"
  1374.    call out
  1375.    call bl
  1376.    str=wht"Would you like to ABORT INPUT? (y/N) > "
  1377.    call getkey
  1378.    answer = upper(hot)
  1379.    if answer = "Y" then do
  1380.     str="YES"
  1381.     call out
  1382.     breakloop = 1
  1383.     drop answer cursor width try
  1384.     return
  1385.    end
  1386.    str="NO"
  1387.    call out
  1388.    call lf2
  1389.    signal limitedwidth
  1390.   end
  1391.  end
  1392.  blfield = 0
  1393.  if nobl = 0 then do
  1394.   do flag = 1 to totallines
  1395.    if entry.flag ~== "" then do
  1396.     blfield = 1
  1397.    end
  1398.   end
  1399.  end
  1400. end
  1401. if nobl = 0 then do
  1402.  if blfield = 0 then do
  1403.   drop blfield
  1404.   entry.1 = bltext
  1405.  end
  1406. end
  1407. call lf2
  1408. drop answer
  1409. call bl
  1410. str =cya"You have entered:"
  1411. call out
  1412. call bl
  1413. do list = 1 to totallines
  1414.  str =wht||entry.LIST
  1415.  call out
  1416. end
  1417. call bl
  1418. str=cya"Is this correct? (Y/n) > "
  1419. call getkey
  1420. answer = upper(hot)
  1421. if answer = "N" then do
  1422.  str="NO"
  1423.  call out
  1424.  call lf2
  1425.  do list = 1 to totallines
  1426.   entry.LINE = ""
  1427.  end
  1428.  drop try answer
  1429.  signal limitedwidth
  1430. end
  1431. str="YES"
  1432. call out
  1433. drop limitedwidth
  1434. return
  1435.  
  1436. CHECKENTRY:
  1437. if cursor = 1 then do
  1438.  if try.1 = "/" then do
  1439.   str=wht"DEd> "
  1440.   call getkey
  1441.   option = upper(hot)
  1442.   if option = "A" then do
  1443.    str="Abort (y/N)? "
  1444.    call getkey
  1445.    answer = hot
  1446.    call ABORTCHECK
  1447.    if breakloop = 1 then do
  1448.     str="Yes"
  1449.     call out
  1450.     return
  1451.    end
  1452.    else do
  1453.     backspace = 3
  1454.     comparefail = 0
  1455.     try.1 = ""
  1456.     return
  1457.    end
  1458.   end
  1459.   if option = "?" then do
  1460.    call ehelp
  1461.    backspace = 3
  1462.    comparefail = 0
  1463.    try.1 = ""
  1464.    return
  1465.   end
  1466.   if option = "L" then do
  1467.    call LISTLINES
  1468.    backspace = 3
  1469.    comparefail = 0
  1470.    try.1 = ""
  1471.    return
  1472.   end
  1473.   if option = "/" then do
  1474.    try.1 = "/"
  1475.    str="D    D"
  1476.    call msg
  1477.    str=line"> "
  1478.    call msg
  1479.    comparefail = 0
  1480.    return
  1481.   end
  1482.   if option = "N" then do
  1483.    drop try entry cursor backspace
  1484.    break = 1
  1485.    return
  1486.   end
  1487.   if option = "D" then do
  1488.    if line = 1 then do
  1489.     try.1 = ""
  1490.     str="D    D"
  1491.     call msg
  1492.     str=LINE"> "
  1493.     call msg
  1494.     backspace = 3
  1495.     comparefail = 0
  1496.     try.1 = ""
  1497.     return
  1498.    end
  1499.    try.1 = ""
  1500.    call DELETELINES
  1501.    backspace = 3
  1502.    comparefail = 0
  1503.    try.1 = ""
  1504.    drop option
  1505.    return
  1506.   end
  1507.   if option = "E" then do
  1508.    if line = 1 then do
  1509.     try.1 = ""
  1510.     str="D    D"
  1511.     call msg
  1512.     str=LINE"> "
  1513.     call msg
  1514.     backspace = 3
  1515.     comparefail = 0
  1516.     try.1 = ""
  1517.     return
  1518.    end
  1519.    call elines
  1520.    backspace = 3
  1521.    comparefail = 0
  1522.    try.1 = ""
  1523.    drop option
  1524.    return
  1525.   end
  1526.   try.1 = ""
  1527.   str="D    D"
  1528.   call msg
  1529.   str=LINE"> "
  1530.   call msg
  1531.   backspace = 3
  1532.   comparefail = 0
  1533.  end
  1534. end
  1535. tempcheck = c2d(try.cursor)
  1536. if tempcheck = "8" then do
  1537.  if cursor < 2 then do
  1538.   backspace = 3
  1539.   return
  1540.  end
  1541.  try.cursor = "D D"
  1542.  backspace = 1
  1543.  return
  1544. end
  1545. if tempcheck = "13" then do
  1546.  do clear = cursor to width
  1547.   try.clear = ""
  1548.  end
  1549.  clear = 1
  1550.  return
  1551. end
  1552. if theend = 1 then do
  1553.  drop theend
  1554.  return
  1555. end
  1556. if cursor = width then do
  1557.  try.cursor = ""
  1558.  cursor = width - 1
  1559.  backspace = 0
  1560.  comparefail = 1
  1561.  return
  1562. end
  1563. comparefail = 0
  1564. return
  1565.  
  1566. eCHECKENTRY:
  1567. tempcheck = c2d(temptry.tempcursor)
  1568. if tempcheck = "8" then do
  1569.  if tempcursor < 2 then do
  1570.   backspace = 3
  1571.   return
  1572.  end
  1573.  temptry.tempcursor = "D D"
  1574.  backspace = 1
  1575.  return
  1576. end
  1577. if tempcheck = "13" then do
  1578.  do clear = tempcursor to width
  1579.   temptry.clear = ""
  1580.  end
  1581.  clear = 1
  1582.  return
  1583. end
  1584. if theend = 1 then do
  1585.  drop theend
  1586.  return
  1587. end
  1588. if tempcursor = width then do
  1589.  temptry.tempcursor = ""
  1590.  tempcursor = width - 1
  1591.  backspace = 0
  1592.  comparefail = 1
  1593.  return
  1594. end
  1595. comparefail = 0
  1596. return
  1597.  
  1598. eHELP:
  1599. str="Help";call out;call lf2;str ="All commands preceded by '/'.";call out;call bl;str ="/A Abort";call out;str ="/D Delete Lines";call out;str ="/E Edit Line";call out;str ="/L List Lines";call out;str ="/N New (start over)"
  1600. call out;str ="// out a '/' (no command)";call out;str ="/? Help";call out;call bl;str=line"> ";call msg;return
  1601.  
  1602. DELETELINES:
  1603. try.1 = ""
  1604. entry.line = ""
  1605. str="Delete from line: "
  1606. length=3
  1607. call input
  1608. from = typed
  1609. if from < 1 | from > line - 1 then do
  1610.  call bl;str=line"> ";call msg;drop from;return
  1611. end
  1612. str="To line: ";length=3;call input;too = typed
  1613. if too < 1 | too > line | too < from then do
  1614.  call bl;str=line"> ";cll msg;drop from to;return
  1615. end
  1616. do deleteprocess = from to too;entry.deleteprocess = "";end
  1617. str="Deleted from line "from" to line "too;call out;call bl;str ="Done.";call out;marker = 0;try.1 = ""
  1618. do forwardcheck = 1 to line
  1619.  if entry.forwardcheck ~= "" then do
  1620.   marker = forwardcheck
  1621.  end
  1622. end
  1623. marker = marker + 1
  1624. if marker > line then do
  1625.  marker = line
  1626. end
  1627. line = marker
  1628. str=line"> "
  1629. call msg
  1630. drop from too marker forwardcheck deleteprocess
  1631. return
  1632.  
  1633. eLINES:
  1634. str="Edit line: "
  1635. length=3
  1636. call input
  1637. eLINE = typed
  1638. if eline > line - 1 | eline < 1 then do
  1639.  call bl
  1640.  str=line"> "
  1641.  call msg
  1642.  drop eline
  1643.  return
  1644. end
  1645. if eline > 0 | eline < line then do
  1646.  call bl
  1647.  str=eline"> "
  1648.  call msg
  1649.  str=entry.eline
  1650.  call msg
  1651.  start = length(entry.eline)
  1652.  temptry.1 = ""
  1653.  do pullin = 1 to start 
  1654.   TTEMPTRY.pullin = left(entry.eline, pullin)
  1655.   TEMPTRY.pullin = right(ttemptry.pullin,1)
  1656.  end
  1657.  start = start + 1
  1658.  do tempcursor = START to width
  1659.   str=""
  1660.   call getkey
  1661.   TEMPTRY.TEMPCURSOR = hot
  1662.   call echeckentry
  1663.   if clear = 1 then break
  1664.   if breakloop = 1 then return
  1665.   if backspace = 3 then do
  1666.    backspace = 0
  1667.    tempcursor = 0
  1668.    comparefail = 1
  1669.    do clear = 1 to width
  1670.     temptry.clear = ""
  1671.    end
  1672.    drop clear
  1673.   end
  1674.   if backspace = 1 then do
  1675.    backspace = 0
  1676.    str=temptry.tempcursor
  1677.    call msg
  1678.    tempcursor = tempcursor - 2
  1679.    comparefail = 1
  1680.   end
  1681.   if comparefail = 0 then do
  1682.    str=temptry.tempcursor
  1683.    call msg
  1684.   end
  1685.  end
  1686.  entry.eLINE = temptry.1
  1687.  do overloop  = 2 to width
  1688.   ENTRY.eLINE = overlay(temptry.overloop,entry.eLINE,overloop)
  1689.  end
  1690.  ENTRY.eLINE = strip(ENTRY.eLINE,"T")
  1691.  ENTRY.LINE = ""
  1692.  try.cursor = ""
  1693.  backspace = 3
  1694.  clear = 0
  1695.  call bl
  1696.  str=line"> "
  1697.  call msg
  1698.  drop eline tempcheck
  1699.  return
  1700. end
  1701. else do
  1702.  call bl
  1703.  str=line"> "
  1704.  call msg
  1705.  drop eline
  1706.  return
  1707. end
  1708. return
  1709.  
  1710. LISTLINES:
  1711. str="List lines"
  1712. call out
  1713. call lf2
  1714. if line = 1 then do
  1715.  str=line"> "
  1716.  call msg
  1717.  return
  1718. end
  1719. do flag = 1 to line - 1
  1720.  str =flag"> "entry.flag
  1721.  call out
  1722. end
  1723. str=line"> "
  1724. call msg
  1725. return
  1726.  
  1727. ABORTCHECK:
  1728. answer = upper(answer)
  1729. if answer = "Y" then do
  1730.  breakloop = 1
  1731.  return
  1732. end
  1733. else do
  1734.  str="D                 D"
  1735.  call msg
  1736.  str=line"> "
  1737.  call msg
  1738.  try.1 = ""
  1739.  cursor = cursor - 2
  1740.  return
  1741. end
  1742.  
  1743. DISPLAY:
  1744. call displayletterc;str =CLS;call out
  1745. call readgra dn,ln,mp"text/card"
  1746. str =home||whtbak||displayletter;call out;str =grnbak||RED"BBS Name: "bla||BBSNAME.1||nor;call out;str =whtbak||red"Sysop Name: "bla||SYSOPNAME.1||nor;call out
  1747. if nodes.1 > 6 then do
  1748.  str =grnbak||red"Total Nodes: "bla||NODES.1" (6) of the ("nodes.1") are listed here."nor;call out
  1749. end
  1750. else do
  1751.  str =grnbak||red"Total Nodes: "bla||NODES.1||nor;call out
  1752. end
  1753. str =whtbak||red"Node 1: "bla||NODE.1||red" MIN BAUD: "bla||MINBAUD.1||red" MAX BAUD: "bla||MAXBAUD.1||nor;call out
  1754. nmx=nodes.1
  1755. if nmx>6 then nmx=6
  1756. if NODES.1 > 1 then do
  1757.  do nno=2 to nmx
  1758.  tcl=whtbak;if nno/2=(nno/2)%1 then tcl=grnbak
  1759.  str =tcl||red"Node "nno": "bla||NODE.nno||red" MIN BAUD: "bla||MINBAUD.nno||red" MAX BAUD: "bla||MAXBAUD.nno||nor;call out
  1760.  end
  1761. end
  1762. do nno=1 to (6-nmx)
  1763.  call bl
  1764. end
  1765. str =whtbak||red"Hours: "bla||HOURS.1||nor;call out;str =grnbak||red"Location: "bla||location.1||nor;call out;str =whtbak||red"BBS Software: "bla||software.1||nor;call out;str =grnbak||red"Computer Support: "bla||support.1||nor;call out
  1766. str =whtbak||red"Storage: "bla||storage.1||nor;call out;str =grnbak||red"Fidonet: "bla||fidonet.1||red" Maxnet: "bla||maxnet.1||red" Online Games: "bla||games.1||red" Files: "bla||files.1||nor;call out
  1767. str =whtbak||red"Fidonet Address: "bla||fad.1||red" Maxnet Address: "bla||mad.1||nor;call out;str =grnbak||red"Comments: "nor;call out;str =whtbak||bla||COMMENTS.1||nor;call out;str =grnbak||bla||COMMENTS.2||nor;call out
  1768. str =whtbak||red"Info by: "bla||NAME.1||red" Last Updated: "bla||date.1||nor;call out;call bl;return
  1769.  
  1770. MINIDISPLAY:
  1771. str =grnbak||bla||BBSNAME.1||nor;call out
  1772. if continue ~= 1 then do
  1773.  more = more + 1;call morecheck
  1774.  if break = 1 then return
  1775. end
  1776. if nodes.1 > 6 then do
  1777.  do nodedisp = 1 to 6
  1778.   str =grn||NODE.nodedisp||red"     BAUDS: "yel||MINBAUD.nodedisp" - "MAXBAUD.nodedisp||nor;call out
  1779.   if continue ~= 1 then do
  1780.    more = more + 1;call morecheck;if break = 1 then return
  1781.   end
  1782.  end
  1783. end
  1784. else do
  1785.  do nodedisp = 1 to NODES.1
  1786.   str =grn||NODE.nodedisp||red"     BAUDS: "yel||MINBAUD.nodedisp" - "MAXBAUD.nodedisp||nor;call out
  1787.   if continue ~= 1 then do
  1788.    more = more + 1;call morecheck;if break = 1 then return
  1789.   end
  1790.  end
  1791. end
  1792. call bl
  1793. if continue ~= 1 then do
  1794.  more = more + 1;call morecheck;if break = 1 then return
  1795. end
  1796. str =wht||COMMENTS.1||nor;call out
  1797. if continue ~= 1 then do
  1798.  more = more + 1;call morecheck;if break = 1 then return
  1799. end
  1800. str =wht||COMMENTS.2||nor;call out
  1801. if continue ~= 1 then do
  1802.  more = more + 1;call morecheck;if break = 1 then return
  1803. end
  1804. call bl;str =red||ll;call out;call bl
  1805. if continue ~= 1 then do
  1806.  more = more + 3;call morecheck;if break = 1 then return
  1807. end;return
  1808.  
  1809. MORECHECK:
  1810. if more > screen - 2 then do
  1811.  str=wht"More(Y/n)?";call getkey;more = upper(hot)
  1812.  if more = "N" then do
  1813.   break = 1;drop more;return
  1814.  end
  1815.  str="D          D";call msg;more = 0
  1816. end;return
  1817.  
  1818. DISPLAYLETTERC:
  1819. displayletter=pur"   "letter;if letter = "MISC" then displayletter = pur" MISC"
  1820. RETURN
  1821.  
  1822. FIDOqu:
  1823. str=dtb" FIDONET (y/n/U) > ";call getkey;answer = upper(hot)
  1824. if answer = "Y" then do
  1825.  str="YES";call out;FIDONET.1 = "YES";drop answer;call bl
  1826.  str=yel||wit" FIDONET ADDRESS (PRESS RETURN IF UNKNOWN) > "cya
  1827.  length=15
  1828.  call input;answer = typed
  1829.  if answer = "" then answer = "Unknown"
  1830.  fad.1 = answer;drop answer;return
  1831. end
  1832. if answer = "N" then do
  1833.  str="NO";call out
  1834.  FIDONET.1 = "NO";fad.1 = "NONE";drop answer;return
  1835. end
  1836. str="UNKNOWN";call out;FIDONET.1 = "Unknown";fad.1 = "Unknown";drop answer;return
  1837.  
  1838. MAXNETqu:
  1839. call lf2;str=dtb" MAXNET (y/n/U) > "
  1840. call getkey;answer = upper(hot)
  1841. if answer = "Y" then do
  1842.  str="YES";call out;MAXNET.1 = "YES";drop answer;call bl;str=yel||wit" MAXNET ADDRESS (PRESS RETURN IF UNKNOWN) > "cya
  1843.  length=15;call input;answer = typed
  1844.  if answer = "" then do
  1845.   answer = "Unknown";str=yel"UNKNOWN"cya;call out
  1846.  end
  1847.  mad.1 = answer;drop answer
  1848.  return
  1849. end
  1850. if answer = "N" then do
  1851.  str="NO"
  1852.  call out
  1853.  MAXNET.1 = "NO"
  1854.  mad.1 = "NONE"
  1855.  drop answer
  1856.  return
  1857. end
  1858. str="UNKNOWN";call out;MAXNET.1 = "Unknown";mad.1 = "Unknown";drop answer;return
  1859.  
  1860. GAMESqu:
  1861. call lf2
  1862. str=dtb" ONLINE GAMES (y/n/U) > "
  1863. call getkey
  1864. answer = upper(hot)
  1865. if answer = "Y" then do
  1866. str="YES"
  1867. call out
  1868. GAMES.1 = "YES"
  1869. drop answer
  1870. return
  1871. end
  1872. if answer = "N" then do
  1873.  str="NO"
  1874.  call out
  1875.  GAMES.1 = "NO"
  1876.  drop answer
  1877.  return
  1878. end
  1879. str="UNKNOWN";call out;GAMES.1 = "Unknown";drop answer;return
  1880.  
  1881. FILESqu:
  1882. call lf2
  1883. str=dtb" FILE AREAS (y/n/U) > "
  1884. call getkey
  1885. answer = upper(hot)
  1886. if answer = "Y" then do
  1887.  str="YES"
  1888.  call out
  1889.  FILES.1 = "YES"
  1890.  drop answer
  1891.  return
  1892. end
  1893. if answer = "N" then do
  1894.  str="NO"
  1895.  call out
  1896.  FILES.1 = "NO"
  1897.  drop answer
  1898.  return
  1899. end
  1900. str="UNKNOWN"
  1901. call out
  1902. FILES.1 = "Unknown"
  1903. drop answer
  1904. return
  1905.  
  1906. NODEINPT:
  1907. comparefail = 0
  1908. str =cls||pet" NUMBER OF NODES (PHONE LINES)"nor||cya
  1909. call out
  1910. call bl
  1911. str=wht"> "
  1912. length=3
  1913. call input
  1914. NODES.1 = typed
  1915. compare = datatype(NODES.1)
  1916. if compare ~= "NUM" then do
  1917.  drop compare
  1918.  str =red"You MUST enter a NUMBER!"
  1919.  call out
  1920.  call bl
  1921.  call returnc
  1922.  signal NODEINPT
  1923. end
  1924. if nodes.1 > 99 then do
  1925.  str =red"I think you are full of it! Try entering a realistic number!"
  1926.  call out
  1927.  call bl
  1928.  call returnc
  1929.  signal NODEINPT
  1930. end
  1931. if NODES.1 < 1 then do
  1932.  str =red"You MUST enter a NUMBER greater than 0"
  1933.  call out
  1934.  call bl
  1935.  call returnc
  1936.  signal NODEINPT
  1937. end
  1938. tempnodes = NODES.1
  1939. if NODES.1 > 6 then do
  1940.  str =cya"The TOTAL NUMBER of nodes will be listed but there will only be"
  1941.  call out
  1942.  str ="space to enter 6. Try to list the MAIN numbers for the BBS."
  1943.  call out
  1944.  call bl
  1945.  tempnodes = 6
  1946. end
  1947. call bl
  1948. do FIELD = 1 to TEMPNODES
  1949.  node.field=""
  1950.  str =grn"All phone entries MUST be in the FORM "NF.myNF
  1951.  call out
  1952.  call bl
  1953.  str =cya"ONLY NUMBERS AND BACKSPACES WILL BE ACCEPTED. Q to ABORT!"
  1954.  call out
  1955.  call bl
  1956.  str=pur"NODE "FIELD": > "wht
  1957.  call msg
  1958.  do entry = 1 to lg
  1959.   str=""
  1960.   call getkey
  1961.   TRY.ENTRY = hot
  1962.   call checkdata
  1963.   if breakloop = 1 then return
  1964.  end
  1965.  nodew.field=""
  1966.  do ctr=1 to lg
  1967.   node.field=node.field||try.ctr
  1968.  end
  1969.  call lf2;drop answer;str=cls;call out;wit=cya"What is the ";wiu=" BAUD RATE supported on this NODE?";str =wit"MINIMUM"wiu;call out;call BAUDS;MINBAUD.FIELD = baud
  1970.  str=cls;call out;str =wit"MAXIMUM"wiu;call out;call BAUDS;MAXBAUD.FIELD = baud;str=cls;call out
  1971.  str =cya"You have entered for NODE "field":";call out
  1972.  str =yel"BBS NUMBER    : "NODE.FIELD;call out
  1973.  str =yel"MINIMUM BAUD  : "MINBAUD.FIELD;call out
  1974.  str =yel"MAXIMUM BAUD  : "MAXBAUD.FIELD;call out;call lf2
  1975.  str=wht"Is this correct (Y/n) > ";call getkey;answer = upper(hot);str=cls;call out
  1976.  if answer = "N" then do
  1977.   node.field="";field = field - 1
  1978.  end
  1979.  call dupecheck
  1980.  if dupefail = 1 then do
  1981.   drop field
  1982.   return
  1983.  end
  1984. end
  1985. drop dupefail
  1986. return
  1987.  
  1988. BAUDS:
  1989. call bl;s1=cya"{"red;s2=cya"} "grn;str =s1"A"s2"300";call out;str =s1"B"s2"1200";call out;str =s1"C"s2"2400";call out;str =s1"D"s2"9600";call out;str =s1"E"s2"14,400";call out;str =s1"F"s2"16,800";call out;str =s1"G"s2"19,200";call out
  1990. str =s1"H"s2"21,600";call out;str =s1"I"s2"28,800";call out;str =s1"J"s2"38,400";call out;str =s1"K"s2"57,600";call out;str =s1"L"s2"ISDN";call out;call bl;str=yel"For node "cya||field;call out;str=wht"Which Letter (Any other choice defaults to UNKNOWN) > "
  1991. length=1;call input;answer = upper(typed);str=answer;call out;call bl;baud="UNKNOWN"
  1992. if answer = "A" then baud = "300";if answer = "B" then baud = "1200";if answer = "C" then baud = "2400";if answer = "D" then baud = "9600"
  1993. if answer = "E" then baud = "14,400";if answer = "F" then baud = "16,800";if answer = "G" then baud = "19,200";if answer = "H" then baud = "21,600"
  1994. if answer = "I" then baud = "28,800";if answer = "J" then baud = "38,400";if answer = "K" then baud = "57,600";if answer = "L" then baud = "ISDN"
  1995. return
  1996.  
  1997. CHECKDATA:
  1998. something = 0
  1999. if upper(try.entry) = "Q" then do
  2000.  breakloop = 1
  2001.  return
  2002. end
  2003. tempcheck = c2d(try.entry)
  2004. if tempcheck = "8" then do
  2005.  if entry<1 then do
  2006.   entry=0
  2007.   return
  2008.  end
  2009.  str = "D D"
  2010.  something=1
  2011.  call msg
  2012.  entry=entry-2
  2013.  if entry < 1 then entry = 0
  2014.  do i=1 to dc
  2015.   if entry=dct.i then do
  2016.    entry=entry-2
  2017.    str="D  D"
  2018.    call msg
  2019.   end
  2020.  end
  2021. end
  2022. do i=1 to dc
  2023.  if (entry+1) = dct.i then do
  2024.   if something=0 then do
  2025.    str=try.entry
  2026.    call msg
  2027.   end
  2028.   entry = entry + 1
  2029.   try.entry = "-"
  2030.   str=try.entry
  2031.   call msg
  2032.   something=1
  2033.   return
  2034.  end
  2035. end
  2036. if something=0 then do
  2037.  str=try.entry
  2038.  call msg
  2039. end
  2040. return
  2041.  
  2042. DUPECHECK:
  2043. call lf2
  2044. str =red"Checking for duplicate entries..."cya
  2045. call out
  2046. call bl
  2047. temptotal=0
  2048. if exists(mp"phones/total") then do
  2049.  call open(file, mp"PHONES/total", "R")
  2050.   temptotal = readln(file)
  2051.  call close(file)
  2052. end
  2053. if temptotal = "0" then do
  2054.  dupefail = 0
  2055.  drop temptotal
  2056.  return
  2057. end
  2058. call open(file, mp"PHONES/NUMBERS", "R")
  2059.  do temploop = 1 to temptotal
  2060.   tempone = readln(file)
  2061.   if tempone = NODE.field then do
  2062.    dupefail = 1
  2063.    call bl
  2064.    str ="Duplicate BBS NUMBER found! Your ENTRY is already on file!"
  2065.    call out
  2066.    temploop = temptotal
  2067.    call returnc
  2068.   end
  2069.   else do
  2070.    dupefail = 0
  2071.   end
  2072.  end
  2073.  drop tempkeith tempone
  2074. call close(file)
  2075. return
  2076.  
  2077. TOTALS:
  2078. call open(file, ipth||letter"/total", "W")
  2079.  call writeln(file, "0")
  2080. call close(file)
  2081. return
  2082.  
  2083. SYSOPMAIN:
  2084. str =cls||sp"     "purbak||wht"SYSOP MENU"nor;call out;call lf2;str =sp||red" {"grn"C"red"}"cya" Clear ALL CARDS";call out
  2085. str =sp||red" {"grn"Q"red"}"cya" Quit to Main";call out;call bl;call cardcount;call bl;str=wht"CHOICE > "
  2086. call getkey;answer = upper(hot);str=answer;call out
  2087. if answer = "Q" then signal main
  2088. if answer = "C" then signal CLEAR
  2089. signal SYSOPMAIN
  2090.  
  2091. CLEAR:
  2092. str =cls||RED"WARNING!! This option will DELETE ALL cards that are in the BBS ROLODEX!";call out;call bl
  2093. str=cya"Are you sure you want to do this?  Type YES if you're sure! > ";length=4
  2094. call input;answer = upper(typed);if answer = "YES" then do
  2095.  str =cls||cya"Deleting ALL cards. Please standby..."; call out
  2096.  address command "DELETE "dpth"#? all QUIET"
  2097.  address command "DELETE "ipth"#? ALL QUIET"
  2098.  address command "DELETE "mp"PHONES/#? ALL QUIET"
  2099.  signal setup
  2100. end
  2101. signal SYSOPMAIN
  2102.  
  2103. FIRSTLETTER:
  2104. LETTER = left(BBSNAME.1,1);tletter = c2d(LETTER);if tletter > 122 then LETTER = "MISC";if tletter > 90 & tletter < 97 then LETTER = "MISC";if tletter > 57 & tletter < 65 then LETTER = "MISC";if tletter < 58 then LETTER = "MISC"
  2105. drop tletter;return
  2106.  
  2107. WRITEPHONE:
  2108. totalnumbers=0
  2109. if exists(mp"phones/total") then do
  2110.  call open(file, mp"PHONES/TOTAL", "R");TOTALNUMBERS = readln(file);call close(file)
  2111. end
  2112. totalnumbers = totalnumbers + tempnodes
  2113. call open(file, mp"PHONES/TOTAL", "W");call writeln(file, TOTALNUMBERS);call close(file)
  2114. call open(file, mp"PHONES/NUMBERS", "A");do flag = 1 to tempnodes;call writeln(file, NODE.FLAG);end;call close(file)
  2115. return
  2116.  
  2117. WRITEeINFO:
  2118. date.1 = date(U);name.1 = un
  2119. call open(file, ipth||letter"/"letter"."ch, "W")
  2120.  call writeln(file, BBSNAME.1);call writeln(file, SYSOPNAME.1);call writeln(file, NODES.1)
  2121.  do lupe=1 to 6;call writeln(file, NODE.lupe);end
  2122.  do lupe=1 to 6;call writeln(file, MINBAUD.lupe);end
  2123.  do lupe=1 to 6;call writeln(file, MAXBAUD.lupe);end
  2124.  call writeln(file, HOURS.1);call writeln(file, LOCATION.1);call writeln(file, SOFTWARE.1);call writeln(file, SUPPORT.1);call writeln(file, STORAGE.1);call writeln(file, FIDONET.1)
  2125.  call writeln(file, MAXNET.1);call writeln(file, GAMES.1);call writeln(file, FILES.1);call writeln(file, fad.1);call writeln(file, mad.1);call writeln(file, COMMENTS.1);call writeln(file, COMMENTS.2)
  2126.  call writeln(file, NAME.1);call writeln(file, DATE.1);call close(file);return
  2127.  
  2128. WRITEINFO:
  2129. total=-1
  2130. if exists(dpth"total") then do;call open(file, dpth"TOTAL", "R");TOTAL = readln(file);call close(file);end
  2131. total = total + 1;call open(file, dpth"TOTAL", "W");call writeln(file, total);call close(file);totalentry=0
  2132. if exists(ipth||letter"/total") then do
  2133.  call open(file, ipth||letter"/total", "R");totalentry = readln(file);call close(file)
  2134. end
  2135. totalentry = totalentry + 1
  2136. call open(file, ipth||letter"/total", "W");call writeln(file, totalentry);call close(file);do i=1 to 1000;end
  2137. call open(file, dpth""letter, "A");call writeln(file, BBSNAME.1);call writeln(file, letter"."totalentry);call close(file);do i=1 to 1000;end
  2138. call open(file, ipth||letter"/"letter"."totalentry, "W");call writeln(file, BBSNAME.1);call writeln(file, SYSOPNAME.1);call writeln(file, NODES.1);do lupe=1 to 6;call writeln(file, NODE.lupe);end;do lupe=1 to 6;call writeln(file, MINBAUD.lupe);end
  2139.  do lupe=1 to 6;call writeln(file, MAXBAUD.lupe);end;call writeln(file, HOURS.1);call writeln(file, LOCATION.1);call writeln(file, SOFTWARE.1);call writeln(file, SUPPORT.1);call writeln(file, STORAGE.1);call writeln(file, FIDONET.1)
  2140.  call writeln(file, MAXNET.1);call writeln(file, GAMES.1);call writeln(file, FILES.1);call writeln(file, fad.1);call writeln(file, mad.1);call writeln(file, COMMENTS.1);call writeln(file, COMMENTS.2);call writeln(file, NAME.1);call writeln(file, DATE.1)
  2141. call close(file);return
  2142.  
  2143. READINFO:
  2144. if ~exists(ipth||letter"/"letter"."ch) then do
  2145.  cantfind=1;return
  2146. end
  2147. if searchreadinfo = 1 then do;call open(file, ipth||letter"/"FOUND.flag, "R");end
  2148. else do;call open(file, ipth||letter"/"letter"."ch, "R");end
  2149. BBSNAME.1 = readln(file);SYSOPNAME.1 = readln(file);NODES.1 = readln(file);do lupe=1 to 6;node.lupe=readln(file);end;do lupe=1 to 6;minbaud.lupe=readln(file);end;do lupe=1 to 6;maxbaud.lupe=readln(file);end;HOURS.1 = readln(file)
  2150. LOCATION.1 = readln(file);SOFTWARE.1 = readln(file);SUPPORT.1 = readln(file);STORAGE.1 = readln(file);FIDONET.1 = readln(file);MAXNET.1 = readln(file);GAMES.1 = readln(file);FILES.1 = readln(file);fad.1 = readln(file);mad.1 = readln(file)
  2151. COMMENTS.1 = readln(file);COMMENTS.2 = readln(file);NAME.1 = readln(file);DATE.1 = readln(file);call close(file);return
  2152.  
  2153. CARDCOUNT:
  2154. tx1="";if totalcards>1 then tx1="s"
  2155. tx2="are";if totalcards = 1 then tx2="is"
  2156. str =yel||BOLD"There "tx2" "red||totalcards||yel" card"tx1" on file.";call out;call bl;return
  2157.  
  2158. lf2:
  2159. call bl;call bl;return
  2160.  
  2161. CREATEDIR:
  2162. str =red||letter"..";call out;call open(file, dpth||letter"", "W");call close(file)
  2163. address command"makedir "ipth||letter" > nil:"
  2164. call totals;return
  2165.  
  2166. RETURNC:
  2167. call bl;str=itl||pur"Press any key to continue...."nor;call getkey;call bl;RETURN
  2168.  
  2169. error:
  2170. call Exit_Door dn,ln
  2171. exit 10
  2172.  
  2173. INUSEENDIT:
  2174. call lf2;str ="Returning to the BBS...";call out;signal getout
  2175.  
  2176. DELETEINUSE:
  2177. if exists(mp"INUSE.txt") then do        
  2178. address command "delete "mp"INUSE.txt QUIET"
  2179. end;return
  2180.  
  2181.  
  2182. ENDIT:
  2183. call deleteinuse;str =cls""cls;call out;signal getout
  2184.  
  2185. CHCAR:
  2186. call cdetect dn,ln;if upper(result)="NO CARRIER!" then signal endit
  2187. return
  2188.  
  2189. GETKEY:
  2190. call chcar
  2191. call hotkey dn,ln,str
  2192. hot=result;call chcar;return
  2193.  
  2194. INPUT:
  2195. call chcar
  2196. call prompt dn,ln,str,length
  2197. typed=result;call CHCAR;return
  2198.  
  2199. MSG:
  2200. call chcar
  2201. call message dn,ln,str,0
  2202. call chcar;return
  2203.  
  2204. GETOUT:
  2205. call bl;str = "You've been using "dn" by "author".";call out;call bl
  2206. str = "Thank you, "un", please press [RETURN] or [ENTER].";call getkey;call bl
  2207. if dlflag=1 then do
  2208. address command "delete "mp"bbslist#? quiet"
  2209. end
  2210. call Exit_Door dn,ln
  2211. exit 0
  2212.  
  2213. sortentries:
  2214. str="Sorting BBS Listings alphabetically, please stand by a moment...";call out;str="This may take a while depending on how many cards exist.  Please be patient.";call out;call bl
  2215. do sloop=1 to 26
  2216.  nk=d2c(sloop+64)
  2217.  call open(file1,ipth||nk"/total",'r');stot.sloop=readln(file1);call close(file1)
  2218.  if stot.sloop ~=0 then do
  2219.   do cx=1 to stot.sloop
  2220.    call open(file2,ipth||nk"/"nk"."cx,'r');entry.sloop.cx=readln(file2);call close(file2)
  2221.   end
  2222.  end
  2223. end
  2224. nk="MISC";sloop=27
  2225. call open(file1,ipth||nk"/total",'r');stot.sloop=readln(file1);call close(file1)
  2226. if stot.sloop~=0 then do
  2227.  do cx=1 to stot.sloop
  2228.   call open(file2,ipth||nk"/MISC."cx,'r');entry.sloop.cx=readln(file2);call close(file2)
  2229.  end
  2230. end
  2231.  
  2232. do kloop=1 to 26;do jloop=1 to stot.sloop;tarray.kloop.jloop=jloop;end;end;tloop=1
  2233. thisloop:
  2234.  if stot.tloop < 2 then signal kip
  2235.  swaps:
  2236.  swflag=0
  2237.  do cx=1 to (stot.tloop)-1
  2238.   tcx=cx+1
  2239.   if entry.tloop.cx > entry.tloop.tcx then do
  2240.    tvr=tarray.tloop.cx;tarray.tloop.cx=tarray.tloop.tcx;tarray.tloop.tcx=tvr;tentry=entry.tloop.cx;entry.tloop.cx=entry.tloop.tcx;entry.tloop.tcx=tentry;swflag=1
  2241.   end
  2242.  end
  2243.  if swflag=1 then signal swaps
  2244.  
  2245. kip:
  2246. tloop=tloop+1;if tloop < 27 then signal thisloop
  2247.  
  2248. do sloop=1 to 26
  2249.  xz=d2c(sloop+64)
  2250.  if stot.sloop > 1 then do
  2251.   do cx=1 to stot.sloop
  2252.    if tarray.sloop.cx ~=cx then do
  2253.     xv=right(tarray.sloop.cx,length(cx))
  2254.     tmr1=ipth||xz||"/"xz;tmr2=tmr1||".temp";nam1=tmr1||"."xv;nam2=tmr2||"."cx
  2255.     address command "copy "||nam1||" to "||nam2
  2256.     do yuk=1 to 600;end
  2257.    end
  2258.   end
  2259.   do cx=1 to stot.sloop
  2260.    if tarray.sloop.cx ~=cx then do
  2261.     xv=right(tarray.sloop.cx,length(cx));tmr1=ipth||xz||"/"||xz;tmr2=tmr1||".temp";nam1=tmr2||"."cx;nam2=tmr1||"."cx
  2262.     address command "copy "||nam1||" to "||nam2
  2263.    end
  2264.   end
  2265.   address command "delete "||tmr2||"#? QUIET"
  2266.  end
  2267. end
  2268. do sloop=1 to 26
  2269.  xx=dpth||d2c(sloop+64)
  2270.  call open(file1,xx,'w');do cx=1 to stot.sloop;call writeln(file1,entry.sloop.cx);call writeln(file1,upper(d2c(sloop+64))||"."||cx);end;call close(file1);end;return
  2271.